Cream of the Crop 26/Cream of the Crop 26.iso/program/p063b9s.zip/UNIT/MSMISC.PAS

Pascal/Delphi Source File | 1997-03-02 | 6KB | 195 lines

UNIT MSMisc;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Mail processor init and de-init               Last changed: 02.03.97  SA ║}
{║                                                                          ║}
{║                         (C) Copyright 1989-97 by                         ║}
{║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
{║                                                                          ║}
{║ This source may not be given to anybody, without the written permission  ║}
{║ from The Portal Team.                                                    ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}

INTERFACE

USES Use32, PoPTypes, MSDefs;

PROCEDURE ReadAreasBBS(VAR AreasBBS:AreasBBSPtr);
PROCEDURE DisposeAreasBBS(VAR AreasBBS:AreasBBSPtr);
PROCEDURE WriteEchoTossLog(VAR AreasBBS:AreasBBSPtr);

IMPLEMENTATION

USES Globals, Util, NetFile, OpString, Send2Utl, FileUtil, LogFile;

  PROCEDURE ReadAreasBBS(VAR AreasBBS:AreasBBSPtr);
  TYPE
    TagListPtr=^TagListType;
    TagListType=RECORD
      Tag      : S30;
      Position : LongInt;
      Next     : TagListPtr;
    END;

  VAR
    i,Test   : INTEGER;
    f        : TNetFile;
    a,
    TmpAreas : AreasBBSPtr;
    t,Tmp    : TagListPtr;
    AreasRec : TMsgArea;
    st       : SendToTabType;
    Dupe     : ^DupeBaseType;

    FUNCTION FindDupePos(CONST s: S30):LongInt;
    BEGIN
      FindDupePos:=-1;
      Tmp:=t;
      WHILE Tmp<>NIL DO
      BEGIN
        IF Tmp^.Tag=s THEN
        BEGIN
          FindDupePos:=Tmp^.Position;
          Exit;
        END ELSE
          Tmp:=Tmp^.Next;
      END;
    END;

  BEGIN
    AreasBBS:=NIL;
    t:=NIL;
    New(Dupe);
    f.Open(StartPath+PoPMsgDupeFileName,SizeOf(DupeBaseType),True);
    WHILE NOT f.EOF DO
    BEGIN
      f.Read(Dupe^,NoKeep,Wait);
      Tmp:=t;
      New(t);
      WITH t^ DO
      BEGIN
        Tag:=Dupe^.Tag;
        position:=f.FILEPOS-1;
        Next:=Tmp;
      END;
    END;
    f.Close;
    IF f.Open(StartPath+PoPMsgAreaFileName,SizeOf(TMsgArea),False) THEN
    BEGIN
      WHILE NOT f.EOF DO
      BEGIN
        f.Read(AreasRec,NoKeep,Wait);
        New(a);
        IF AreasBBS=NIL THEN
          AreasBBS:=a
        ELSE
        BEGIN
          TmpAreas:=AreasBBS;
          WHILE TmpAreas^.Next<>NIL DO
            TmpAreas:=TmpAreas^.Next;
          TmpAreas^.Next:=a;
        END;
        WITH a^ DO
        BEGIN
          { Flyt brugte felter her }
          Area.Directory:=StringToHeap(AreasRec.Directory);
          Area.ImportSB:=AreasRec.ImportSB;
          Area.Scanned:=AreasRec.Scanned;
          Area.ScanDate:=AreasRec.ScanDate;
          Area.MaxScan:=AreasRec.MaxScan;
          Area.UsedAKA:=AreasRec.UsedAKA;
          FOR i:=1 TO 3 DO
            Area.Echonames[i]:=StringToHeap(AreasRec.EchoNames[i]);
          i:=LENGTH(Area.Directory^);
          WHILE (i>0) AND (Area.Directory^[i]<>'\') DO
            DEC(i);
          VAL(COPY(Area.Directory^,i+1,3),QNum,Test);
          DupePos:=FindDupePos(Area.EchoNames[1]^);
          ReadSendTo(AreasRec.SendTo,st,SendNum[1]);
          IF SendNum[1]>0 THEN
          BEGIN
            GetMem(SendTo[1],SizeOf(TFidoAddress)*SendNum[1]);
            MoveFast(st,SendTo[1]^,SizeOf(TFidoAddress)*SendNum[1]);
          END ELSE
            SendTo[1]:=NIL;
          ReadSendTo(AreasRec.SendOnly,st,SendNum[2]);
          IF SendNum[2]>0 THEN
          BEGIN
            GetMem(SendTo[2],SizeOf(TFidoAddress)*SendNum[2]);
            MoveFast(st,SendTo[2]^,SizeOf(TFidoAddress)*SendNum[2]);
          END ELSE
            SendTo[2]:=NIL;
          NewMail:=False;
          Next:=NIL;
        END;
      END;
      f.Close;
    END;
    WHILE t<>NIL DO
    BEGIN
      Tmp:=t;
      t:=t^.Next;
      Dispose(Tmp);
    END;
    Dispose(Dupe);
  END;

  PROCEDURE DisposeAreasBBS(VAR AreasBBS:AreasBBSPtr);
  VAR
    tmp:AreasBBSPtr;
    ea:TMsgArea;
    f : TNetFile;
    i:BYTE;
  BEGIN
    IF f.Open(StartPath+PoPMsgAreaFileName,SizeOf(TMsgArea),False) THEN
    BEGIN
      WHILE AreasBBS<>NIL DO
      BEGIN
        Tmp:=AreasBBS;
        AreasBBS:=AreasBBS^.Next;
        IF Tmp^.SendTo[1]<>NIL THEN FreeMem(Tmp^.SendTo[1],SizeOf(TFidoAddress)*Tmp^.SendNum[1]);
        IF Tmp^.SendTo[2]<>NIL THEN FreeMem(Tmp^.SendTo[2],SizeOf(TFidoAddress)*Tmp^.SendNum[2]);
        IF Tmp^.NewMail THEN
        BEGIN
          f.GetRec(ea,f.FILEPOS,keep,wait);
          ea.ScanDate:=Tmp^.Area.ScanDate;
          ea.Scanned:=Tmp^.Area.Scanned;
          f.PutRec(ea,f.FILEPOS-1);
        END ELSE
          f.SEEK(f.FILEPOS+1);
        DisposeString(Tmp^.Area.Directory);
        FOR i:=1 TO 3 DO
          DisposeString(Tmp^.Area.EchoNames[i]);
        Dispose(Tmp);
      END;
      f.Close;
    END;
  END;

  PROCEDURE WriteEchoTossLog(VAR AreasBBS:AreasBBSPtr);
  VAR
    f : Text;
    TmpAreas:AreasBBSPtr;
  BEGIN
    IF Cfg.MailScanner.EchoTossLog<>'' THEN
    BEGIN
      Assign(f, Cfg.MailScanner.EchoTossLog);
      REWRITE(f);
      IF IOResult=0 THEN
      BEGIN
        TmpAreas:=AreasBBS;
        WHILE TmpAreas<>NIL DO
        BEGIN
          IF TmpAreas^.NewMail THEN WriteLn(f,TmpAreas^.Area.EchoNames[1]^);
          TmpAreas:=TmpAreas^.Next;
        END;
        Close(f);
      END ELSE
      BEGIN
        AddLog('!','Error creating '+Cfg.MailScanner.EchoTossLog);
      END;
    END;
  END;

END.